home *** CD-ROM | disk | FTP | other *** search
/ IRIS Performer 2.2 Friends Demo / SGI IRIS Performer 2.2 Friends Demo.iso / friends / openworlds / tix / Tix.tcl < prev    next >
Text File  |  1997-11-22  |  10KB  |  412 lines
  1. #----------------------------------------------------------------------
  2. # Tix application context class
  3. #
  4. #
  5. if 0 {
  6.     rename option __option
  7.  
  8.     proc option {args} {
  9.     puts $args
  10.     eval __option $args
  11.     }
  12.  
  13. }
  14.  
  15. tixClass tixAppContext {
  16.     -superclass {}
  17.     -classname  TixAppContext
  18.     -method {
  19.     cget configure addbitmapdir filedialog getbitmap getimage
  20.     option resetoptions setbitmap
  21.     }
  22.     -flag {
  23.     -binding -debug -filedialog -fontset -grabmode -haspixmap
  24.     -libdir -scheme
  25.     }
  26.     -readonly {
  27.     -haspixmap
  28.     }
  29.     -configspec {
  30.     {-binding        TK}
  31.     {-debug          false}
  32.     {-filedialog    {}}
  33.     {-fontset        TK}
  34.     {-grabmode     global}
  35.     {-haspixmap     0}
  36.     {-libdir         {}}
  37.     {-scheme         TK}
  38.     }
  39.     -alias {
  40.     }
  41. }
  42.  
  43. proc tixAppContext::Constructor {w} {
  44.     upvar #0 $w data
  45.     global tix_priv env argv0
  46.     global tix_library
  47.  
  48.     if {$tix_library == "nowhere"} {
  49.     set data(et) 1
  50.     } else {
  51.     set data(et) 0
  52.     }
  53.  
  54.     set data(isStartUp) 1
  55.     # Thses options were set when tixwish started up
  56.     #
  57.     set data(-binding)    $tix_priv(-binding)
  58.     set data(-debug)    $tix_priv(-debug)
  59.     set data(-fontset)    $tix_priv(-fontset)
  60.     set data(-libdir)    $tix_priv(-libdir)
  61.     set data(-scheme)    $tix_priv(-scheme)
  62.     set data(-libdir)    $tix_library
  63.     
  64.     # Enable/Disable Intrinsics debugging
  65.     #
  66.     if {$data(-debug)} {
  67.     set tix_priv(debug) 1
  68.     } else {
  69.     set tix_priv(debug) 0
  70.     }
  71.  
  72.     tixAppContext::config-fontset $w $data(-fontset)
  73.     tixAppContext::config-scheme  $w $data(-scheme)
  74.  
  75.     tixAppContext::BitmapInit $w
  76.     tixAppContext::FileDialogInit $w
  77.  
  78.     if {[tixGetBoolean -nocomplain $data(-debug)]} {
  79.     # For widget programming, it is more convient to have the error
  80.     # message printed on the terminal. For some extensive usage of
  81.     # bindings, suce as in the case of tixBalloon, the default
  82.     # therror just doesn't work.
  83.     #
  84.     proc ___tkerror {err} {
  85.         global errorInfo
  86.         puts $err
  87.         puts $errorInfo
  88.     }
  89.     }
  90.  
  91.     # Force the "." window to accept the new Tix options
  92.     #
  93.     foreach spec [. configure] {
  94.     if {[llength $spec] > 2} {
  95.         set flag  [lindex $spec 0]
  96.         set name  [lindex $spec 1]
  97.         set class [lindex $spec 2]
  98.         set value [option get . $name $class]
  99.         catch {. config $flag $value}
  100.     }
  101.     }
  102.     set data(isStartUp) 0
  103.  
  104.     # Some hack: if env(TIX_DEBUG_INTERACTIVE) is set, then
  105.     # an interactive prompt is always printed
  106.     if [info exists env(TIX_DEBUG_INTERACTIVE)] {
  107.     if {![string match *tixwish* $argv0]} {
  108.         # Looks like this was not started up as an interactive shell
  109.         # Let's open an interactive input from stdin
  110.         tixShellInput
  111.     }
  112.     }
  113. }
  114.  
  115. #----------------------------------------------------------------------
  116. #  Configurations
  117. #
  118. #----------------------------------------------------------------------
  119. proc tixAppContext::resetoptions {w scheme fontset} {
  120.     upvar #0 $w data
  121.  
  122.     if {! $data(et)} {
  123.     option clear
  124.     tixAppContext::config-scheme  $w $scheme
  125.     tixAppContext::config-fontset $w $fontset
  126.     }
  127. }
  128.  
  129. proc tixAppContext::config-fontset {w value} {
  130.     upvar #0 $w data
  131.     global tix_priv tixOption
  132.  
  133.     set data(-fontset) $value
  134.  
  135.     #-----------------------------------
  136.     # Initialization of options database
  137.     #-----------------------------------
  138.     # Load the fontset
  139.     #
  140.     if {!$data(et)} {
  141.     if [file exists $data(-libdir)/pref/$data(-fontset).fsc] {
  142.         source $data(-libdir)/pref/$data(-fontset).fsc
  143.         tixPref:InitFontSet:$data(-fontset)
  144.         tixAppContext::CheckFontSets $w
  145.         tixPref:SetFontSet:$data(-fontset)
  146.     } else {
  147.         puts stderr "\aError: cannot use fontset \"$data(-fontset)\""
  148.         puts stderr "       Using default fontset "
  149.         tixSetDefaultFontset
  150.         tixAppContext::CheckFontSets $w
  151.     }
  152.     } else {
  153.     if [catch {
  154.         tixPref:InitFontSet:$data(-fontset)
  155.         tixAppContext::CheckFontSets $w
  156.         tixPref:SetFontSet:$data(-fontset)
  157.     }] {
  158.         # User chose non-existent fontset
  159.         #
  160.         puts stderr "\aError: cannot use fontset \"$data(-fontset)\""
  161.         puts stderr "       Using default fontset "
  162.         tixSetDefaultFontset
  163.         tixAppContext::CheckFontSets $w
  164.     }
  165.     }
  166.  
  167.     # Compatibility stuff: the bsolete name courier_font has been changed to
  168.     # fixed_font
  169.     set tixOption(courier_font) $tixOption(fixed_font)
  170. }
  171.  
  172. proc tixAppContext::config-scheme {w value} {
  173.     upvar #0 $w data
  174.     global tix_priv
  175.  
  176.     set data(-scheme) $value
  177.  
  178.     # Load the color scheme
  179.     #
  180.     if {!$data(et)} {
  181.     if [file exists $data(-libdir)/pref/$data(-scheme).csc] {
  182.         source $data(-libdir)/pref/$data(-scheme).csc
  183.         if {[winfo depth .] >= 8} {
  184.         tixPref:SetScheme-Color:$data(-scheme)
  185.         } else {
  186.         tixPref:SetScheme-Mono:$data(-scheme)
  187.         }
  188.     } else {
  189.         puts stderr "\aError: cannot use color scheme \"$data(-scheme)\""
  190.         puts stderr "       Using default color scheme"
  191.         if {[winfo depth .] >= 8} {
  192.         tixSetDefaultScheme-Color
  193.         } else {
  194.         tixSetDefaultScheme-Mono
  195.         }
  196.     }
  197.     } else {
  198.     if [catch {
  199.         if {[winfo depth .] >= 8} {
  200.         tixPref:SetScheme-Color:$data(-scheme)
  201.         } else {
  202.         tixPref:SetScheme-Mono:$data(-scheme)
  203.         }
  204.     }] {
  205.         # User chose non-existent color scheme
  206.         #
  207.         puts stderr "\aError: cannot use color scheme \"$data(-scheme)\""
  208.         puts stderr "       Using default color scheme"
  209.         if {[winfo depth .] >= 8} {
  210.         tixSetDefaultScheme-Color
  211.         } else {
  212.         tixSetDefaultScheme-Mono
  213.         }
  214.     }
  215.     }
  216. }
  217.  
  218. #----------------------------------------------------------------------
  219. #  Private methods
  220. #
  221. #----------------------------------------------------------------------
  222. proc tixAppContext::BitmapInit {w} {
  223.     upvar #0 $w data
  224.  
  225.     # See whether we have pixmap extension
  226.     #
  227.     set data(-haspixmap) true
  228.  
  229.     # Dynamically set the bitmap directory
  230.     #
  231.     if {! $data(et)} {
  232.     set data(bitmapdirs) $data(-libdir)/bitmaps
  233.     } else {
  234.     set data(bitmapdirs) {}
  235.     }
  236. }
  237.  
  238. proc tixAppContext::FileDialogInit {w} {
  239.     upvar #0 $w data
  240.  
  241.     if {$data(-filedialog) == {}} {
  242.     set data(-filedialog) [option get . fileDialog FileDialog]
  243.     }
  244.     if {$data(-filedialog) == {}} {
  245.     set data(-filedialog) tixFileSelectDialog
  246.     }
  247. }
  248.  
  249. #----------------------------------------------------------------------
  250. # If a font in the fontset is not available, use a default fontset.
  251. #
  252. proc tixAppContext::CheckFontSets  {w} {
  253.     upvar #0 $w data
  254.     global tixOption
  255.  
  256.     set default_font "fixed"
  257.     set options {font bold_font menu_font italic_font fixed_font}
  258.  
  259.     set lab [label .tix-xxx-test]
  260.     foreach opt $options {
  261.     if [catch {$lab config -font $tixOption($opt)}] {
  262.         puts stderr \
  263.         "\aError: cannot use font \"$tixOption($opt)\" as \"$opt\""
  264.         puts  stderr \
  265.         "       using \"$default_font\" instead"
  266.  
  267.         set tixOption($opt) $default_font
  268.     }
  269.     }
  270.     destroy $lab
  271. }
  272.  
  273. #----------------------------------------------------------------------
  274. #     Public methods
  275. #----------------------------------------------------------------------
  276. proc tixAppContext::addbitmapdir {w bmpdir} {
  277.     upvar #0 $w data
  278.  
  279.     if {[lsearch $data(bitmapdirs) $bmpdir] == "-1"} {
  280.     set data(bitmapdirs) [concat $bmpdir $data(bitmapdirs)]
  281.     }
  282. }
  283.  
  284. proc tixAppContext::getimage {w name} {
  285.     upvar #0 $w data
  286.  
  287.     if {[info exists data(img:$name)]} {
  288.     return $data(img:$name)
  289.     }
  290.  
  291.     foreach dir $data(bitmapdirs) {
  292.     if [file exists $dir/$name.xpm] {
  293.         if {![catch {
  294.         set data(img:$name) \
  295.             [image create pixmap -file $dir/$name.xpm]
  296.         }]} {
  297.         break
  298.         }
  299.     }
  300.     if [file exists $dir/$name.xbm] {
  301.         if {![catch {
  302.         set data(img:$name) \
  303.             [image create bitmap -file $dir/$name.xbm]
  304.         }]} {
  305.         break
  306.         }
  307.     }
  308.     if [file exists $dir/$name] {
  309.         if {![catch {
  310.         set data(img:$name) \
  311.             [image create bitmap -file $dir/$name]
  312.         }]} {
  313.         break
  314.         }
  315.     }
  316.     }
  317.  
  318.     if {![info exists data(img:$name)]} {
  319.     catch {
  320.         # This is for compiled-in images
  321.         set data(img:$name) [image create pixmap -id $name]
  322.     } err
  323.     if [string match internal* $err] {
  324.         error $err
  325.     }
  326.     }
  327.  
  328.     if {[info exists data(img:$name)]} {
  329.     return $data(img:$name)
  330.     } else {
  331.     error "image file \"$name\" cannot be found"
  332.     }
  333. }
  334.  
  335.  
  336. proc tixAppContext::getbitmap {w bitmapname} {
  337.     upvar #0 $w data
  338.  
  339.     if {[info exists data(bmp:$bitmapname)]} {
  340.     return $data(bmp:$bitmapname)
  341.     } else {
  342.     set ext [file extension $bitmapname]
  343.     if {$ext == ""} {
  344.         set ext .xbm
  345.     }
  346.  
  347.     # This is the fallback value. If we can't find the bitmap in
  348.     # the bitmap directories, then use the name of the bitmap
  349.     # as the default value.
  350.     #
  351.     set data(bmp:$bitmapname) $bitmapname
  352.  
  353.     foreach dir $data(bitmapdirs) {
  354.         case $ext {
  355.         .ppm {
  356.             if [file exists $dir/$bitmapname] {
  357.             set data(bmp:$bitmapname) \
  358.                 [image create photo -file $dir/$bitmapname]
  359.             break
  360.             }
  361.         }
  362.         .xbm {
  363.             if [file exists $dir/$bitmapname.xbm] {
  364.             set data(bmp:$bitmapname) @$dir/$bitmapname.xbm
  365.             break
  366.             }
  367.             if [file exists $dir/$bitmapname] {
  368.             set data(bmp:$bitmapname) @$dir/$bitmapname
  369.             break
  370.             }
  371.         }
  372.         default {
  373.             if [file exists $dir/$bitmapname] {
  374.             set data(bmp:$bitmapname) @$dir/$bitmapname
  375.             break
  376.             }
  377.         }
  378.         }
  379.     }
  380.  
  381.     return $data(bmp:$bitmapname)
  382.     }
  383. }
  384.  
  385. proc tixAppContext::filedialog {w {type tixFileSelectDialog}} {
  386.     upvar #0 $w data
  387.  
  388.     if {$type == {}} {
  389.     set type $data(-filedialog)
  390.     }
  391.     if {![info exists data(filedialog,$type)]} {
  392.     set data(filedialog,$type) {}
  393.     }
  394.  
  395.     if {$data(filedialog,$type) == {} || ![winfo exists $data(filedialog,$type)]} {
  396.     set data(filedialog,$type) [$type .tixapp_filedialog_$type]
  397.     }
  398.  
  399.     return $data(filedialog,$type)
  400. }
  401.  
  402. proc tixAppContext::option {w action option {value {}}} {
  403.     upvar #0 $w data
  404.     global tixOption
  405.  
  406.     if {$action == "get"} {
  407.     return $tixOption($option)
  408.     }
  409. }
  410.  
  411. tixAppContext tix
  412.